GERSWE

rm(list = ls())
setwd("~/Projects/news_tweets")
## --- Load Packages --- ##
library(rtweet)
library(dplyr)
library(ggplot2)
library(rvest)
library(tidyr)
library(wordcloud2)
library(igraph)
library(ggraph)
library(stringr)
library(tm)
library(tidytext)
library(stringi)
library(lubridate)

## --- Set Stylings --- ###
knitr::opts_chunk$set(message=FALSE, warning=FALSE)

theme_set(
  theme_bw(base_size = 14) +
    theme(
      plot.title = element_text(face = "bold", size = 14, 
                                margin = margin(0, 0, 4, 0, "pt")),
      plot.subtitle = element_text(size = 12),
      plot.caption = element_text(size = 6, hjust = 0),
      axis.title = element_text(size = 10),
      panel.border = element_blank()
    )
)

## --- Global Variables --- ##
# Define Color
Mycol <- RColorBrewer::brewer.pal(8, "Dark2")

# Define http pattern
http <- paste("http.*","https.*", sep = "|")

# Define Stopwords
stopwords <- data_frame(
  word =  stopwords("german")
) %>% rbind(
  data_frame(word = c("t.co","via","mal","dass","mehr", "amp","https",
                      "beim", "ab","sollen","ganz","sagt",
                      "schon","rt","gibt", "ja", "natürlich"))
)

Deutschsprachige Tweets die den Hashtag “#GERSWE” beinhalten. Die Tweets wurden mit Hilfe des R Packetes rtweet über die REST API ausgelesen. Der gesamte Code ist hier einzusehen.

Folgende Variablen sind in unserem Datensatz vorhanden.

load("../../data/germex.Rda")
attr(rt$created_at, "tzone") <- "Europe/Berlin"

start <- as.POSIXct("2018-06-17 16:00", tz = "Europe/Berlin")
end <- start + minutes(220)

gamestart <- as.POSIXct("2018-06-17 17:00", tz = "Europe/Berlin")
gameend <- gamestart + minutes(112)

rt_small <- rt %>% 
#  mutate(created_at = as.POSIXct(created_at + hours(2))) %>%
  filter(created_at >= start) %>%
  filter(created_at <= end) 

Zeitraum

rt_small %>%
  ts_plot("1 minute",
        color = Mycol[3]) +
  geom_vline(xintercept = gamestart, color=Mycol[1], linetype = 2) +
  geom_vline(xintercept = gameend, color=Mycol[1], linetype = 2) +
  theme(plot.title = element_text(face = "bold"),
        axis.text.x = element_blank()) +
  labs(
    x = NULL, y = NULL,
    title = "Tweets zum Spiel Deutschland - Mexiko",
    subtitle = paste("Zeitraum:",min(rt$created_at),"bis",max(rt$created_at))
  ) 

Retweets

Welche Tweets wurden am häufigsten geteilt? Die top 10 sind:

rt_small %>%
  filter(is_retweet == FALSE ) %>%
  dplyr::select(screen_name, text, retweet_count) %>%
  group_by(screen_name, text) %>%
  summarise(retweet_count = sum(retweet_count)) %>%
  arrange(desc(retweet_count)) %>%
  .[1:10,] %>%
  #knitr::kable(align = "l")
  htmlTable::htmlTable(align="l")

	screen_name	text	retweet_count
1	DFB_Team	Schluss! #DieMannschaft verliert den WM-Auftakt gegen Mexiko. #GERMEX 0-1 #ZSMMN https://t.co/wE73FNLBrv	1356
2	ThatRexGuy	Joachim Löw when literally anything happens. #GERMEX #WorldCup https://t.co/5e0xQ9Q3Yy	1172
3	KuehniKev	Sportminister ist in #Deutschland übrigens Horst Seehofer. 🤷🏼‍♂️ #GERMEX	906
4	DerWachsame	Wir haben ein Fußballspiel verloren, das ist traurig, aber nicht schlimm. Morgen wird vielleicht ein durchgeknallter Innenminister im Alleingang die Grenzen schließen und die Regierung sprengen. DAS ist schlimm. #GERMEX	801
5	ghensel	Mal im Ernst. Rausfliegen in der Vorrunde passt doch bombe zu unserer masochistischen Gefühlslage gerade. Ich sehe schon die Talkshow-Themen vor mir: „Deutsches WM-Aus. Welche Rolle spielt der Islam?“ #GERMEX	499
6	DFB_Team	Seid ihr bereit für #GERMEX 🇩🇪🇲🇽? #ZSMMN #WM2018 #GERMEX https://t.co/POxvqBKDBj	491
7	DFB_Team	Auf geht’s, Männer!!! 🇩🇪🇲🇽 #ZSMMN #WM2018 #GERMEX 0-0 https://t.co/l13goZrece	470
8	DFB_Team	Halbzeit. Mund abputzen. Da geht noch was, Männer! #GERMEX 0-1 #DieMannschaft #ZSMMN https://t.co/0ZJu1R64iL	443
9	OomenBerlin	Seit wir Nazis im Bundestag haben hat die #Nationalmannschaft noch kein WM-Spiel gewonnen. Denkt mal drüber nach. #GERMEX #WM2018	440
10	FCBayern	🇩🇪 Kopf hoch, Männer! #WeiterImmerWeiter #GERMEX #DieMannschaft #WM2018 https://t.co/CLHAah2jJo	431

Wordcloud

rt_clean <- rt_small %>%
  # First, remove http elements manually
  mutate(stripped_text = gsub(http,"", text)) %>%
  mutate(stripped_text = gsub("germex","", text, ignore.case = T)) 
  
rt_tidy_words <- rt_clean %>%
  # Second, remove punctuation, convert to lowercase, add id for each tweet!
  dplyr::select(stripped_text) %>%
  unnest_tokens(word, stripped_text) %>%
  
  # Third, remove stop words from your list of words 
  anti_join(stopwords) %>%
  
  # Count Word occurences in a tweet
  count(word, sort = TRUE) 

rt_tidy_words %>%
  wordcloud2(size = 3, 
           color = "random-light", backgroundColor = "grey")

Wie sind die Wörter miteinander verlinkt?

word_network(rt_clean)

Sentiment Analyse

SentimentWortschatz, or SentiWS for short, is a publicly available German-language resource for sentiment analysis, opinion mining etc. It lists positive and negative polarity bearing words weighted within the interval of [-1; 1] plus their part of speech tag, and if applicable, their inflections. The current version of SentiWS (v1.8b) contains 1,650 positive and 1,818 negative words, which sum up to 15,649 positive and 15,632 negative word forms incl. their inflections, respectively. It not only contains adjectives and adverbs explicitly expressing a sentiment, but also nouns and verbs implicitly containing one.

sent <- c(
  # positive Wörter
  readLines("../../dict/SentiWS_v1.8c_Negative.txt",
            encoding = "UTF-8"),
  # negative Wörter
  readLines("../../dict/SentiWS_v1.8c_Positive.txt",
            encoding = "UTF-8")
) %>% lapply(function(x) {
  # Extrahieren der einzelnen Spalten
  res <- strsplit(x, "\t", fixed = TRUE)[[1]]
  return(data.frame(words = res[1], value = res[2],
                    stringsAsFactors = FALSE))
}) %>%
  bind_rows %>% 
  mutate(word = gsub("\\|.*", "", words) %>% tolower,
         value = as.numeric(value)) %>%
  # manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
  group_by(word) %>% summarise(value = mean(value)) %>% ungroup

sentDF <- rt_clean %>%
  # Second, remove punctuation, convert to lowercase, add id for each tweet!
  unnest_tokens(word, stripped_text) %>%
  left_join(., sent, by="word") %>% 
  mutate(value = as.numeric(value)) %>% 
  #filter(!is.na(value)) %>%
  mutate(negative = ifelse(value < 0, value, NA),
         positive = ifelse(value > 0, value, NA),
         negative_d = ifelse(value < 0, 1, 0),
         positive_d = ifelse(value > 0, 1, 0)) 

Wordclouds

Positive Wörter

Negative wörter

Top 10 positive Tweets

sentDF.grouped <- sentDF %>%
  group_by(status_id) %>%
  summarise(mean_value = mean(value, na.rm = T),
            sum_value = sum(value, na.rm = T),
            positive = sum(positive, na.rm = T),
            negative = sum(negative, na.rm = T)) %>%
  left_join(., rt_small %>% dplyr::select(status_id, screen_name, text, created_at),
            by = "status_id") %>%
  filter(!is.na(mean_value))

sentDF.grouped %>%
  arrange(desc(mean_value)) %>%
  select(screen_name, text, mean_value, created_at) %>%
  .[1:10,] %>%
  htmlTable::htmlTable(align="l")

	screen_name	text	mean_value	created_at
1	Hessenfriese	@BILD Ist uns fast gelungen….. #GERMEX #WM2018 https://t.co/quDq0wTnMX	1	2018-06-17 17:01:12
2	Mastermind_09	Draxler und Reus bislang ungefähr mit gleich vielen gelungen Ballaktionen. #GERMEX	1	2018-06-17 17:22:02
3	GmachtZumTxtn	Noch nie ist es einer Mannschaft gelungen seinen eigenen Linksverteidiger so aus dem Spiel zu nehmen #GERMEX	1	2018-06-17 18:37:26
4	nerdfromaustria	Der Sonntag wäre perfekt, wenn Deutschland eins auf die Nase kriegt… Ganz neutral gesprochen ;) #GERMEX #WM2018	0.7299	2018-06-17 16:12:47
5	DerFilmer	That feel wenn der @BR24 Radiokommentar perfekt synchron zum @BBCSport Fernsehbild ist. #GERMEX #WM2018	0.7299	2018-06-17 17:11:25
6	mir70	Kimmich passt vom Sympathiefaktor perfekt zum FC Bayern … #GERMEX	0.7299	2018-06-17 17:26:16
7	nerow1909	@Endi_AJ Wer gerade mal seinen lamborghini ausfahren will, kann das gerade perfekt tun. Auch in der kölner innenstadt. #germex	0.7299	2018-06-17 17:31:51
8	Sarpei007	Naja. Die Taktik von Mex ist halt perfekt gegen die immergleiche Aufstellung/Taktik von uns. #GERMEX	0.7299	2018-06-17 17:46:21
9	allo_morph	Ich nutze auch perfekt die Räume. Im Schlafzimmer schlafe ich, im Wohnzimmer wohne ich, im Badezimmer dusche ich…och Menno! #GERMEX	0.7299	2018-06-17 17:54:25
10	hassanscorner	Man muss aber auch sagen, dass der Testspielgegner Saudi-Arabien die Mexikaner perfekt simuliert hat. #GERMEX	0.7299	2018-06-17 17:54:43

Top 10 negative Tweets

sentDF.grouped %>%
  arrange(mean_value) %>%
  select(screen_name, text, mean_value, created_at) %>%
  .[1:10,] %>%
  htmlTable::htmlTable(align="l")

	screen_name	text	mean_value	created_at
1	DieMone37	Neuer wird nicht in die Gefahr kommen einzuschlafen. #WM2018 #GERMEX	-1	2018-06-17 17:02:47
2	hyouhakuhunter	Deine Meinungsfreiheit ist in Gefahr! @fckart13 #FCKArt13 #GERMEX #WM2018 https://t.co/h8XhRv1Adu	-1	2018-06-17 17:04:02
3	sirxwastaken	Das Internet ist in Gefahr und ihr habt nur Augen für einen Ball. Schaut wenigstens in der Halbzeit mal vorbei und informiert euch! https://t.co/QujMbEK3E1 #GERMEX #fckart13 #WM2018 #ger #mex #DieMannschaft	-1	2018-06-17 17:04:22
4	sportwetten_de	Min., 0:0: Aber auch Mexikos Freistöße sind eher eine Bewerbung für Fieldgoals beim Football als eine Gefahr für Manuel Neuer. #swde #GERMEX #liveticker #WM2018	-1	2018-06-17 17:10:31
5	Baumbart4Z0	Das freie Internet ist in Gefahr! #WM2018 #FCKArt13 #GERMEX https://t.co/lmKRfYI6bK	-1	2018-06-17 17:13:00
6	anjaSeeBR	Am 20/21.06 stimmt das EUparlament über Artikel 13 ab. Memes, Videos, Remixe, Parodien, Zitate sind in Gefahr #Meinungsfreiheit Informier dich: https://t.co/KhlVEENOXh #GERMEX #WM2018 #savetheinternet #FCKArt13 #SaveOurInternet	-1	2018-06-17 17:20:59
7	Winkendekatze	SCHAUT NICHT WEG! Das Internet ist in Gefahr! WM2018 GERMEX #FCKart13 https://t.co/SLDh8eSEav	-1	2018-06-17 17:22:28
8	Jan_04	Teilweise vogelwild - auf beiden Seiten. An sich mal ein ganz angenehmer Kontrast zum kontrollierten Fußball in der Bundesliga. Birgt aber die Gefahr, dass beim Abpfiff 80 Millionen Deutsche Boatengs Haarfarbe haben. #GERMEX #WM2018	-1	2018-06-17 17:23:29
9	marcelbuslay	Am 20. Juni 2018 wird über Artikel 13 abgestimmt. Helft mit das Zensurgesetzt zu verhindern bevor es zu spät ist. Informiere dich jetzt: https://t.co/JeRueO11zn Deine Meinungsfreiheit ist in Gefahr! #FCKArt13 #savetheinternet #saveyourinternet #GERMEX https://t.co/7a1DQSsj6h	-1	2018-06-17 17:25:20
10	Kwn69943344	Das Internet ist in Gefahr! Informier dich! #WM2018 #GERMEX #FCKart13 https://t.co/zmDr4x4lxM https://t.co/6wbQTu4ybH	-1	2018-06-17 17:28:54

sentDF.grouped %>%
  mutate(time = as.POSIXct(substr(created_at,1,16))) %>%
  group_by(time) %>%
  summarise(mean_value = mean(mean_value)) %>%
  ggplot() +
  geom_line(aes(time, mean_value),
             color = Mycol[3]) +
  geom_vline(xintercept = gamestart, color = Mycol[2], linetype = 2) +  
  geom_vline(xintercept = gameend, color = Mycol[2], linetype = 2) +
  labs(y = "", x="", title = "Durchschnittlicher Sentiment Wert")